home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / sorting.swg / 0041_Linked list sort.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-11-02  |  3.6 KB  |  179 lines
  1. (*
  2. IAN LIN
  3.  
  4. > Can someone show me an example of how to properly dispose of a linked list?
  5.  
  6. I was just as bad when I started in February. :) Anyhow, use mark and
  7. release. They're 2 new things I've discovered and love much more than
  8. dispose or freemem. Use MARK(ram) where VAR RAM:POINTER {an untyped
  9. pointer}. This will save the state of the heap. NOW, when you are done,
  10. do this: release(ram) and it's back the way it was. No freemem, no dispose,
  11. just RELEASE! I REALLY love it. :) Need to allocate and deallocate some
  12. times in between the beginning and the end? Use more untyped pointers (eg.
  13. RAM2, RAM3, etc.) and you get the picture. Gotta love it. :) Look for a
  14. message from me in here about linked list sorting. I wrote an entire
  15. program that does this (to replace DOS's sort. Mine's faster and can use
  16. more than 64k RAM). Here it is. Some of it is maybe too hard for you but
  17. then you can ignore that part and just see how I used mark and release.
  18. *)
  19.  
  20. {$A+,B-,D-,E-,F-,G-,I-,L-,N-,O-,R-,S-,V-,X-}
  21. {$M 8192, 0, 655360}
  22.  
  23. type
  24.   pstring = ^string;
  25.   prec    = ^rec;
  26.  
  27.   rec     = record
  28.     s : pstring;
  29.     n : prec;
  30.   end;
  31.  
  32. Var
  33.   dash   : byte;
  34.   err,
  35.   max, c : word;
  36.   list,
  37.   list2,
  38.   node,
  39.   node2  : prec;
  40.   ram,
  41.   ram2,
  42.   ram3   : pointer;
  43.   tf     : text;
  44.   f      : file;
  45.  
  46. procedure dodash;
  47. begin
  48.   case dash of
  49.     1 : write('-');
  50.     2 : write('\');
  51.     3 : write('|');
  52.     4 : write('/');
  53.   end;
  54.   write(#8, ' ', #8);
  55.   dash := dash mod 4 + 1;
  56. end;
  57.  
  58. procedure TheEnd;
  59. begin
  60.   writeln('Assassin Technologies, NetRunner.');
  61.   halt(err);
  62. end;
  63.  
  64. procedure showhelp;
  65. begin
  66.   writeln('Heavy duty sorter. Syntax: NSORT <INFILE> <OUTFILE>.');
  67.   writeln('Exit codes: 0-normal; 1-not enough RAM; 2-can''t open infile;');
  68.   writeln('3-outfile can''t be created');
  69.   halt;
  70. end;
  71.  
  72. procedure noram;
  73. begin
  74.   release(ram);
  75.   assign(f, paramstr(1));
  76.   writeln('Not enough RAM. ', memavail div 1024, 'k; file: ', filesize(f));
  77.   err := 1;
  78.   halt;
  79. end;
  80.  
  81. procedure newnode(var pntr : prec);
  82. begin
  83.   if sizeof(prec) > maxavail then
  84.   begin
  85.     close(tf);
  86.     noram;
  87.   end;
  88.   new(pntr);
  89.   dodash;
  90.   pntr^.n := nil;
  91. end;
  92.  
  93. procedure getln(var ln : pstring);
  94. var
  95.   line : string;
  96.   size : word;
  97. begin
  98.   readln(tf, line);
  99.   size := succ(length(line));
  100.   if size > maxavail then
  101.     noram;
  102.   getmem(ln, size);
  103.   move(line, ln^, succ(length(line)));
  104.   dodash;
  105. end;
  106.  
  107. begin
  108.   err := 0;
  109.   exitproc := @TheEnd;
  110.   if paramcount = 0 then
  111.     showhelp;
  112.   assign(tf, paramstr(1));
  113.   reset(tf);
  114.  
  115.   if ioresult <> 0 then
  116.   begin
  117.     writeln('Can''t open "', paramstr(1), '".');
  118.     err := 2;
  119.     halt;
  120.   end;
  121.  
  122.   mark(ram);
  123.   newnode(list);
  124.  
  125.   if not eof(tf) then
  126.   begin
  127.     getln(list^.s);
  128.     node := list;
  129.  
  130.     while not eof(tf) do
  131.     begin
  132.       newnode(node^.n);
  133.       node := node^.n;
  134.       getln(node^.s);
  135.     end;
  136.  
  137.     close(tf);
  138.     newnode(list2);
  139.     list2^.n := list;
  140.     list := list^.n;
  141.     list2^.n^.n := nil;
  142.  
  143.     while list <> nil do
  144.     begin
  145.       dodash;
  146.       node  := list;
  147.       list  := list^.n;
  148.       node2 := list2;
  149.  
  150.       while (node2^.n <> nil) and (node^.s^ > node2^.n^.s^) do
  151.         node2 := node2^.n;
  152.  
  153.       node^.n  := node2^.n;
  154.       node2^.n := node;
  155.       dodash;
  156.     end;
  157.     list := list2^.n;
  158.  
  159.     assign(tf, paramstr(2));
  160.     rewrite(tf);
  161.     if ioresult <> 0 then
  162.     begin
  163.       writeln('Can''t create "', paramstr(2), '"');
  164.       err := 3;
  165.     end;
  166.  
  167.     node := list;
  168.     while node <> nil do
  169.     begin
  170.       writeln(tf, node^.s^);
  171.       node := node^.n;
  172.       dodash;
  173.     end;
  174.     writeln;
  175.     close(tf);
  176.     release(ram);
  177.   end;
  178. end.
  179.